COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	PARFNS
C00006 00003	LOOKUP:
C00011 00004	GETNAM:
C00013 00005	MAKATM:
C00015 00006	SYNNYM:
C00017 00007	SPAT:
C00019 00008	STHGHT:
C00024 00009	DSKLOC:
C00026 00010		INSYN, INSPAT, INCPAT, INDSKL:
C00028 00011	STP:
C00032 00012	GETBP:	SKIPE	OVERLA			 SKIP IF NOT OVERLAYING
C00036 00013	MISC:
C00039 00014	SWAPIT:
C00042 00015	NEDIT:		 TAKES A 4 DIGIT NUMBER (0 < X ≤ 9999) AND FORMATS WITH A DECIMAL
C00046 ENDMK
C⊗;
	TITLE	PARFNS

EXTERNAL PNAME,T,NIL,GC,NCONS,XCONS,INTERN,BPORG,BPEND,NUMVAL,FIX1A,EVAL
INTERNAL MAKATM,SYNNYM,SPAT,CPAT,STHGHT,CTHGHT,DSKLOC,ROGER
INTERNAL DATEUU,TIMEUU,PPNUU,TTYUU,PTYMUU,SWAPIT,FIX2Z,SLEEP,SNEAK,INCHAR
INTERNAL SWAPNO,SWAPP,NAMEIN,NEDIT,PTYOUU,RUNTIM

A←1↔B←2↔C←3↔D←4↔E←5			;ARGUMENT AND SCRATCH REGS
WORD←6↔LEN←7↔TAB←10↔TABL←11↔LB←12↔UB←13	;SPECIAL REGS FOR HERE
P←14↔FR←15↔FW←16↔SP←17			;LISP SPECIAL REGS

INFILE:	0				;HOLDS THE CHOSEN FILE NAME
SYFILE:	SIXBIT	/SYNONM/		;THESE ARE THE INDIVIDUAL FILE NAMES
SPFILE:	SIXBIT	/SPATS/
CPFILE:	SIXBIT	/CPATS/
DLFILE:	SIXBIT	/PDATX/

ALFILE:	SIXBIT	/ALL/			;THIS BLOCK IS USED FOR ALL LOOKUPS
	SIXBIT	/PAR/
	0
	SIXBIT	/  1  3/		;THIS IS CLOBBERED WITH EACH USE

PPN:	SIXBIT	/  1  3/		;THIS IS USED TO REPLACE THE ONE ABOVE
RCP:	SIXBIT	/PARRCP/		;THIS IS SOMETIMES PUT IN PPN

MULTFL:	0				; 0 = ALL.PAR, -1 = 4 SEPARATE FILES
ALLOPN:	0				; -1 = ALL.PAR ALREADY OPEN

USETNO:	0				; HOLDS ADDRESS OF CHOSEN USET NUMBER
SYUSET:	1				; USET NUMBERS FOR THE 4 SINGLE FILES
SPUSET:	1
CPUSET:	1
DLUSET:	1

ATMHDR←←777777
PATMAX←←=10
PATERN:	BLOCK	PATMAX
NAME:	BLOCK	PATMAX

OVERLA:	0				;0 = ALL IN CORE, -1 = OVERLAID
OLDBPO:	0				;ORIGINAL BPORG FOR OVERLAYING

INDEX:	0				;HOLDS ADDRESS OF CHOSEN INDEX FLAG
ITSYN:	0				;-1 = TABLE INDEX IN CORE
ITSPAT:	0
ITCPAT:	0
ITDSKL:	0

ISYN:	0				;-1 = TABLE IN CORE
ISPAT:	0
ICPAT:	0
IDSKL:	0

TBL:	0				;HOLDS ADDRESS OF CHOSEN INDEX
SYTABS:	0				;SYNONYM TABLES DESCRIPTORS
	BLOCK	PATMAX+1
SPTABS:	0				;SIMPLE PATTERN TABLES DESCRIPTORS
	BLOCK	PATMAX+1
CPTABS:	0				;COMPLEX PATTERN TABLES DESCRIPTORS
	BLOCK	PATMAX+1
DLTABS:	0
	BLOCK	PATMAX+1

CHAR:	0

SAVADR:	SIXBIT	/DSK/
	SIXBIT	/HAR000/
	SIXBIT	/SAV/
	0
	0

GETADR:	SIXBIT	/DSK/
	SIXBIT	/NO    /
	0
	0
	SIXBIT  /DIAKMC/
	0

GETADP:	SIXBIT	/DSK/
	SIXBIT	/P     /
	0
	0
	SIXBIT  /DIAKMC/
	0

RETNIL:					;RETURN NIL TO LISP
	MOVEI	A,NIL
	POPJ	P,
LOOKUP:
	;ASSUMPTIONS: (PATERN),...,(PATERN+(LEN)) CONTAIN THE OBJECT TO BE MATCHED,
	;(LEN) IS THE NUMBER OF WORDS IT OCCUPIES. (TAB) IS ASSUMED TO BE A TABLE
	;WHICH DESCRIBES ANOTHER SET OF TABLES WHICH CONTAIN PATTERNS. THE FIRST
	;WORD OF THE DESCRIPTOR TABLE IS THE NUMBER OF PATTERN TABLES WHOSE
	;ADDRESSES FOLLOW (ADDRESS=ZERO MEANS NO TABLE OF PATTERNS OF THIS LENGTH).
	;PATTERN TABLE N CONTAINS ALL PATTERNS OF LENGTH N, AND THE FIRST WORD OF
	;THE TABLE STORES THE NUMBER OF PATTERNS IN THE LEFT HALF, THE VALUE TABLE'S
	;ADDRESS IN THE RIGHT. THERE ARE (LEN)-1 MORE TABLES IMMEDIATELY ADJACENT
	;IN HIGHER CORE LOCATIONS WHICH STORE THE 2ND-(LEN)TH REMAINING PATTERN
	;WORDS FOR PATTERNS LONGER THAN (LEN)=1.
	;LOOKUP RETURNS AS (A) THE INDEX OF THE LOCATED PATTERN, OR ZERO IF THE
	;LOOKUP WAS UNSUCCESSFUL. (LEN) IS UNCHANGED, (TAB) RETURNS POINTING TO
	;THE TABLE HEADER OF THE TABLE WHICH LOOKUP USED

	CAILE	LEN,PATMAX		;SKIP IF PATTERNS OF THIS LENGTH EXIST
	JRST	[SETZM A↔POPJ P,]	;OTHERWISE FAIL
	ADD	TAB,LEN			;GET APPROPRIATE TABLE ADDRESS
	SKIPN	TAB,(TAB)		;(TAB) IS TABLE ADDRESS, SKIP IF EXISTS
	JRST	[SETZM A↔POPJ P,]	;OTHERWISE FAIL
	MOVE	WORD,PATERN		;(WORD) WILL HOLD THE PATTERN FIRST WORD
	LSH	WORD,-1			;CLEAR BIT 0 SO SIGN WON'T INTERFERE
	MOVE	LB,TAB			;SET UP LOWER AND UPPER BOUND FOR LOOKUP
	MOVE	UB,TAB
	HLRZ	TABL,(TAB)		;(TABL)=TABLE LENGTH
	ADDI	UB,1(TABL)
LKP1:					;TOP OF THE BINARY LOOKUP ALGORITHM
	MOVEI	A,1(LB)			;TEST FOR LB+1≥UB
	CAMG	UB,A
	JRST	[SETZM A↔POPJ P,]	;LOOKUP FAILS, RETURN 0
	ADDI	A,-1(UB)		;COMPUTE (LB+UB)/2
	LSH	A,-1			;(A) IS NEXT PROBE ADDRESS
	MOVE	B,(A)			;(B) IS TABLE PROBE WORD
	LSH	B,-1			;SHIFT SIGN BIT CLEAR
	CAMN	B,WORD			;SKIP IF NOT EQUAL
	JRST	LKP3			;1ST WORD MATCHES, GO TRY REST
LKP2:					;PROBE FAILED, DECIDE WHICH OF LB,UB TO MOVE
	CAML	B,WORD
	JRST	[MOVE UB,A↔JRST LKP1]	;MOVE UPPER BOUND DOWN
	MOVE	LB,A			;MOVE LOWER BOUND UP
	JRST	LKP1			;TRY NEXT PROBE
LKP3:					;1ST WORDS EQUAL, TRY WORDS 2,...,(LEN)
	MOVE	C,A			;(C) WILL INDEX HIGHER TABLES
	MOVN	D,LEN
	HRLZ	D,D			;(D) WILL COUNT OFF REMAINING PATTERN WORDS
LKP4:
	AOBJP	D,[SUB A,TAB↔POPJ P,]	;SUCCESS, RETURN INDEX
	ADD	C,TABL			;(C) IS ADDR OF NEXT WORD PROBE
	MOVE	B,(C)			;(B) IS NEXT PROBE WORD
	CAMN	B,PATERN(D)
	JRST	LKP4			;NTH WORDS EQUAL, CONTINUE
	LSH	B,-1			;CLEAR SIGN BIT
	MOVE	C,PATERN(D)		;(C) IS PATTERN WORD
	LSH	C,-1			;CLEAR ITS SIGN
	CAML	B,C			;DECIDE WHICH OF LB,UB TO MOVE
	JRST	[MOVE UB,A↔JRST LKP1]	;MOVE UB DOWN
	MOVE	LB,A			;MOVE LB UP
	JRST	LKP1			;CONTINUE WITH NEXT PROBE
GETNAM:
	;ASSUMES (A) IS A POINTER TO A LISP ATOM HEADER. LOCATES THE PNAME
	;OF THIS ATOM AND RETURNS WITH (NAME),...,(NAME+(LEN)) CONTAINING THE
	;NAME AND (LEN) INDICATING THE NUMBER OF WORDS THE NAME OCCUPIES.

	SETZM	NAME			;PRECLEAR THE NAME ARRAY
	MOVE	B,[XWD NAME,NAME+1]
	BLT	B,NAME+PATMAX-1
	MOVSI	C,-PATMAX		;(C) WILL COUNT UP NUMBER OF WORDS IN NAME
	HLRZ	B,(A)			;CHECK FOR ATOM HEADER
	CAIE	B,ATMHDR
	JRST	GNM3			;NOT AN ATOM, RETURN NULL NAME
	HRRZ	A,(A)			;(A) IS THE PROPERTY LIST
GNM0:					;SEARCH FOR PNAME PROPERTY
	JUMPE	A,GNM3			;NO PNAME FOUND, RETURN NULL NAME
	HLRZ	B,(A)			;(B)← CAR(A), B IS THE NEXT PROPERTY NAME
	CAIN	B,PNAME			;SKIP IF NOT PNAME
	JRST	GNM1			;PNAME FOUND, GO GET IT
	HRRZ	A,(A)			;GET NEXT PROPERTY NAME
	HRRZ	A,(A)
	JRST	GNM0			;CONTINUE SEARCH
GNM1:
	HRRZ	A,(A)			;(A)← CDR(A)
	HLRZ	A,(A)			;(A)← CAR(A), (A) IS NOW CAR OF PNAME LIST
GNM2:					;COLLECT THE ASCII
	JUMPE	A,GNM3			;END OF PNAME LIST
	HLRZ	B,(A)			;(B) POINTS TO ASCII WORD
	MOVE	B,(B)			;(B) IS NEXT 5 CHARS OF ASCII
	MOVEM	B,NAME(C)		;STORE IN NEXT NAME ARRAY POSITION
	HRRZ	A,(A)			;(A)← CDR(A)
	AOBJN	C,GNM2			;COUNT UP AND GET NEXT 5 CHARS
GNM3:
	HRRZ	LEN,C			;(LEN)= NUMBER OF WORDS NAME OCCUPIES
	POPJ	P,			;RETURN
MAKATM:
	;ASSUMES (A) IS THE ADDRESS OF ONE WORD OF ASCII WHICH IS TO BE MADE
	;INTO AN INTERNED LISP ATOM. RETURNS WITH (A) POINTING TO SUCH AN ATOM.

	MOVE	A,(A)			;(A) IS 5 ASCII CHARS
	JUMPN	FW,MKA1			;JUMP IF FULL WORDS SPACE EXISTS
	PUSH	P,A			;NO MORE FW SPACE, MUST GARBAGE COLLECT
	PUSHJ	P,GC
	POP	P,A
MKA1:
	MOVE	B,FW			;(B) IS FULL WORD ADDRESS
	HRRZ	FW,(FW)			;UNLINK IT
	MOVEM	A,(B)			;STORE ASCII IN IT
	MOVE	A,B			;CONS IT WITH NIL
	PUSHJ	P,NCONS
	PUSHJ	P,NCONS			;(A) IS NOW THE END OF THE ATOM'S PROP LIST
	MOVEI	B,PNAME			;CONS ON THE PROPERTY NAME
	PUSHJ	P,XCONS
	MOVEI	B,ATMHDR		;MAKE THE ATOM HEADER
	PUSHJ	P,XCONS			;(A) IS THE ATOM
	PUSHJ	P,INTERN		;INTERN IT
	POPJ	P,			;RETURN
SYNNYM:
	;ASSUMES (A) IS AN ATOM WHOSE PNAME IS AN ENGLISH WORD FOR WHICH A
	;STANDARD SYNONYM IS DESIRED. RETURNS WITH (A) NIL IF NO SUCH WORD CAN
	;BE FOUND, A LIST CONTAINING THE STANDARD SYNONYM OTHERWISE.

	SKIPN	ISYN
	PUSHJ	P,INSYN
	PUSHJ	P,GETNAM		;THE ATOM'S PNAME IS NOW ASCII IN NAME,...
	MOVE	A,[XWD NAME,PATERN]	;TREAT THE NAME LIKE ANY OTHER PATTERN
	BLT	A,PATERN+PATMAX-1	;COPY NAME TO PATERN
	MOVEI	TAB,SYTABS		;LOOK IT UP IN SYNONYM TABLES
	PUSHJ	P,LOOKUP		;(A) IS LOOKUP RESULT
	JUMPE	A,RETNIL		;NOT FOUND
	HRRZ	B,(TAB)			;(B) IS VALUE TABLE'S ADDRESS
	ADD	A,B			;(A) IS VALUE'S ADDRESS
	PUSHJ	P,MAKATM		;MAKE IT A LISP ATOM
	PUSHJ	P,NCONS			;MAKE IT A LIST
	POPJ	P,			;RETURN

SPAT:
	SKIPN	ISPAT
	PUSHJ	P,INSPAT
	MOVEI	TAB,SPTABS
	JRST	SCPAT
CPAT:
	SKIPN	ICPAT
	PUSHJ	P,INCPAT
	MOVEI	TAB,CPTABS

SCPAT:
	;ASSUMES (A) IS A LIST OF ATOMS WHICH ARE TO BE LOOKED UP AS A SIMPLE
	;OR COMPLEX PATTERN, AND THAT (TAB) POINTS TO TABLE DESCRIPTOR BLOCK
	;SPTABS OR CPTABS. RETURNS PATTERN NAME IF FOUND, NIL OTHERWISE.

LIST←LB					;USE THESE ACS FOR DIFFERENT THINGS
CNT←UB
	MOVE	LIST,A			;(LIST) WILL BE THE LIST POINTER
	SETZM	PATERN			;PRE-CLEAR THE PATERN AREA
	MOVE	A,[XWD PATERN,PATERN+1]
	BLT	A,PATERN+PATMAX-1
	MOVSI	CNT,-PATMAX		;(CNT) WILL COUNT LIST LENGTH
SCP1:
	JUMPE	LIST,SCP2		;END OF LIST, GO LOOK PATTERN UP
	HLRZ	A,(LIST)		;(A) IS NEXT ATOM OF LIST
	HRRZ	LIST,(LIST)		;(LIST)← CDR(LIST)
	PUSHJ	P,GETNAM		;NAME,... CONTAINS ASCII NAME
	MOVE	A,NAME			;USE ONLY FIRST FIVE CHARS IN PATTERN
	MOVEM	A,PATERN(CNT)
	AOBJN	CNT,SCP1		;GET NEXT ATOM
SCP2:					;(PATERN),... CONTAINS PATTERN
	HRRZ	LEN,CNT			;(LEN) IS PATTERN WORD LENGTH
	PUSHJ	P,LOOKUP		;LOOK PATTERN UP
	JUMPE	A,RETNIL		;NO SUCH PATTERN, RETURN NIL
	HRRZ	B,(TAB)			;(B) IS ADDR OF VALUE TABLE
	ADD	A,B			;(A) IS ADDRESS OF VALUE
	PUSHJ	P,MAKATM		;(A) IS LISP ATOM
	POPJ	P,			;RETURN

STHGHT:
	SKIPN	ISPAT
	PUSHJ	P,INSPAT
	MOVEI	B,SPTABS
	JRST	THOUGT
CTHGHT:
	SKIPN	ICPAT
	PUSHJ	P,INCPAT
	MOVEI	B,CPTABS

THOUGT:
	;ASSUMES (A) IS SIMPLE OR COMPLEX PATTERN NAME, (B) DENOTES WHICH TABLES
	;TO USE. LOCATES ALL PATTERNS WHICH MAP ONTO THIS NAME AND
	;RETURNS THEN AS A LIST. IF NONE ARE FOUND, RETURNS NIL.

SCAN←LB

	SETZM	PCNT			;PCNT WILL COUNT NUMBER OF PATTERNS FOUND
	PUSH	P,B
	PUSHJ	P,GETNAM		;(NAME),... CONTAINS PATTERN`S NAME
	POP	P,B
	JUMPE	LEN,RETNIL		;RETURN NIL IF NO PNAME FOUND
	MOVNI	A,PATMAX+1		;CONSTRUCT PATTERN TABLE INDEX
	HRL	B,A			;(B) WILL COUNT OFF TABLES
	MOVE	A,NAME			;(A) IS THE PATTERN NAME
	SETZM	LEN			;(LEN) WILL BE THE PAT LEN OF CURRENT TABLE
THT1:
	AOBJP	B,THT4			;START NEXT TABLE, JUMP IF NO MORE TABLES
	ADDI	LEN,1			;PATTERNS HERE ARE OF ONE GREATER LENGTH
	SKIPN	TAB,(B)			;(TAB) IS TABLE ADDRESS
	JRST	THT1			;NO TABLE FOR PATTERNS OF THIS LENGTH
	HLRZ	TABL,(TAB)		;(TABL) IS TABLE'S LENGTH
	HRRZ	C,(TAB)			;(C) WILL BE THE VALUE TABLE'S ADR
	MOVEI	SCAN,1(C)		;(SCAN) WILL SCAN THE VALUE TABLE FOR NAME
	MOVN	D,TABL
	HRL	SCAN,D
THT2:
	CAME	A,(SCAN)		;COMPARE NEXT VALUE
	JRST	THT3			;NO MATCH, CONTINUE
	MOVEI	E,(SCAN)		;STORE CRITICAL DATA FOR THIS LOCATED PAT
	SUB	E,C			;(E) IS TABLE INDEX OF PATTERN'S FIRST WORD
	ADD	E,TAB			;(E) IS ADDRESS OF PATTERN'S FIRST WORD
	HRL	E,TABL			;PUT TABLE LENGTH IN LEFT HALF
	LSH	LEN,=32			;OR IN PATTERN LENGTH AS LEFTMOST 4 BITS
	OR	E,LEN
	LSH	LEN,-=32		;RESTORE (LEN)
	PUSH	P,E			;RECORD THIS FIND
	AOS	PCNT			;COUNT IT
THT3:
	AOBJN	SCAN,THT2		;CONTINUE
	JRST	THT1			;THIS TABLE EXHAUSTED, GO TO NEXT
THT4:
	SKIPN	A,PCNT			;ALL TABLES SEARCHED, SKIP IF PATTERNS FOUND
	JRST	RETNIL			;NONE FOUND, RETURN NIL
	MOVEM	A,PCNT1			;SOME FOUND, MAKE EACH INTO LISP LIST
THT5:
	MOVN	A,A			;COMPUTE STACK ADDRESS OF NEXT INFO WORD
	ADDI	A,1(P)			;(A) IS ADDRESS OF NEXT INFO WORD
	MOVEM	A,PADR			;SAVE IT FOR LATER
	MOVE	A,(A)			;(A) IS INFO WORD
	HRRZM	A,PTR			;SAVE PATTERN FIRST WORD ADDRESS
	LDB	B,[POINT 4,A,3]		;(B) IS PATTERN LENGTH
	MOVEM	B,PLEN1			;SAVE IT
	MOVEM	B,PLEN2
	LDB	B,[POINT =14,A,=17]	;GET TABLE LENGTH
	MOVEM	B,TLEN			;SAVE IT
THT6:					;ASSEMBLE THIS PATTERN INTO A LIST
	MOVE	A,PTR			;(A) IS ADDRESS OF NEXT PATTERN WORD
	MOVE	B,TLEN
	ADDM	B,PTR			;INCREMENT ADDRESS TO NEXT PATTERN WORD
	PUSHJ	P,MAKATM		;MAKE (A) INTO A LISP ATOM
	PUSH	P,A			;SAVE ATOM
	SOSLE	PLEN1			;SKIP IF DONE
	JRST	THT6			;GO GET NEXT PATTERN WORD
	MOVEI	A,NIL			;CONSTRUCT THE PATTERN LIST
THT7:
	POP	P,B
	PUSHJ	P,XCONS
	SOSLE	PLEN2
	JRST	THT7
	MOVEM	A,@PADR			;(A) IS THE LIST POINTER, SAVE BACK IN STACK
	SOSLE	A,PCNT			;COUNT DOWN PATTERNS
	JRST	THT5			;MORE, ASSEMBLE NEXT PATTERN INTO LIST
	MOVEI	A,NIL			;ALL ASSEMBLED, ASSEMBLE INTO BIG LIST
THT8:
	POP	P,B			;(B) IS NEXT PATTERN LIST POINTER
	PUSHJ	P,XCONS
	SOSLE	PCNT1
	JRST	THT8
	POPJ	P,			;(A) IS BIG LIST, RETURN

PTR:	0
TLEN:	0
PLEN1:	0
PLEN2:	0
PCNT:	0
PCNT1:	0
PADR:	0
DSKLOC:
	;ASSUMES (A) IS AN ATOM WITH WHICH A NUMERIC KEY (THE CHARACTER COUNT
	;WITHIN THE FILE CONTAINING PARRY'S RESPONSES) IS ASSOCIATED. RETURNS
	;NIL IF NO SUCH ATOM EXISTS, ITS ASSOCIATED NUMBER OTHERWISE.

	SKIPN	IDSKL
	PUSHJ	P,INDSKL
	PUSHJ	P,GETNAM		;THE ATOM'S PNAME IS NOW ASCII IN NAME,...
	MOVE	A,[XWD NAME,PATERN]	;TREAT THE NAME LIKE ANY OTHER PATTERN
	BLT	A,PATERN+PATMAX-1	;COPY NAME TO PATERN
	MOVEI	TAB,DLTABS		;LOOK IT UP IN DSKLOC TABLES
	PUSHJ	P,LOOKUP		;(A) IS LOOKUP RESULT
	JUMPE	A,RETNIL		;NOT FOUND
	HRRZ	B,(TAB)			;(B) IS VALUE TABLE'S ADDRESS
	ADD	A,B			;(A) IS VALUE'S ADDRESS
	MOVE	A,(A)
	PUSHJ	P,FIX1A			;MAKE IT A LISP NUMBER
	POPJ	P,			;RETURN
	;INSYN, INSPAT, INCPAT, INDSKL:
	;ROUTINES TO READ IN SYNONYM, SPAT, CPAT AND DKLOC TABLES. ASSUME WE'RE
	;LIVING IN LISP BINARY PROGRAM SPACE.

INSYN:
	MOVE	B,SYFILE		; GET FILE NAME
	MOVEM	B,INFILE
	MOVEI	B,SYUSET  		; GET THE PROPER NUMBER TO USE IN USETI
	MOVEM	B,USETNO
	MOVEI	B,[ASCIZ/SYNONYM/]	; FOR MESSAGE
	MOVEM	B,FILNAM
	MOVEI	B,ITSYN			; ADR OF SYNONM INDEX FLAG
	MOVEM	B,INDEX
	MOVEI	B,SYTABS		; ADR OF SYNONM TABLES
	MOVEM	B,TBL
	PUSHJ	P,STP
	SETOM	ISYN			; MARK DATA AS IN
	POPJ	P,

INSPAT:
	MOVE	B,SPFILE
	MOVEM	B,INFILE
	MOVEI	B,SPUSET
	MOVEM	B,USETNO
	MOVEI	B,[ASCIZ/SPAT/]
	MOVEM	B,FILNAM
	MOVEI	B,ITSPAT
	MOVEM	B,INDEX
	MOVEI	B,SPTABS
	MOVEM	B,TBL
	PUSHJ	P,STP
	SETOM	ISPAT
	POPJ	P,

INCPAT:
	MOVE	B,CPFILE
	MOVEM	B,INFILE
	MOVEI	B,CPUSET
	MOVEM	B,USETNO
	MOVEI	B,[ASCIZ/CPAT/]
	MOVEM	B,FILNAM
	MOVEI	B,ITCPAT
	MOVEM	B,INDEX
	MOVEI	B,CPTABS
	MOVEM	B,TBL
	PUSHJ	P,STP
	SETOM	ICPAT
	POPJ	P,

INDSKL:
	MOVE	B,DLFILE
	MOVEM	B,INFILE
	MOVEI	B,DLUSET
	MOVEM	B,USETNO
	MOVEI	B,[ASCIZ/DSKLOC/]
	MOVEM	B,FILNAM
	MOVEI	B,ITDSKL
	MOVEM	B,INDEX
	MOVEI	B,DLTABS
	MOVEM	B,TBL
	PUSHJ	P,STP
	SETOM	IDSKL
	POPJ	P,

FILNAM:	0					;HOLDS ADDRESS OF ASCIZ NAME OF FILE
STP:

ORG← LB
CH← 17
HDR←←PATMAX+2

	PUSH	P,A			; SAVE ARG FROM LISP ROUTINE WHICH CALLED US

	SKIPE	ALLOPN			; SKIP IF ALL.PAR NOT OPEN
	JRST	BOTH
	SKIPN	MULTFL			; SKIP IF USING MULTIPLE FILES
	JRST	TRYALL

OPN:	INIT	CH,17			;INITIALIZE FILE READ IN DUMP MODE
	SIXBIT	/DSK/
	0
	JRST	[OUTSTR [ASCIZ/CAN'T INITIALIZE READ CHANNEL!
/]
		 CALLI 12]
	MOVE	B,INFILE		; GET INPUT FILE NAME
	MOVEM	B,ALFILE
	MOVE	B,PPN			; PPN OF TABLE FILE
	MOVEM	B,ALFILE+3
	LOOKUP	CH,ALFILE		;LOOK UP TABLE FILE
	JRST	REDERR
BOTH:	SKIPE	@INDEX			; SKIP IF NEED INDEX
	JRST	HAVEID
FIRST:	MOVE	A,@USETNO		; GET USET NUMBER
	USETI	CH,@A			; SET TO BEGINNING OF HEADER RECORD
	MOVSI	A,-HDR			;SET UP IOWD TO READ IN TABLE HEADER
	HRR	A,TBL
	SUBI	A,1
	SETZM	B
	IN	CH,A			;READ IN PATMAX+2 HEADER WORDS
	JRST	GETBP			; SUCCESSFUL READ, GO GET BP SPACE
	JRST	REDERR			; UNSUCCESSFUL READ

HAVEID:	MOVE	A,@USETNO		; GET USET NUMBER
	ADDI	A,1			; PAST THE TABLE RECORD
	USETI	CH,@A			; SET TO BEGINNING OF TABLE
	JRST	GETBP

TRYALL:	INIT	CH,17			;INITIALIZE FILE READ IN DUMP MODE
	SIXBIT	/DSK/
	0
	JRST	[OUTSTR [ASCIZ/CAN'T INITIALIZE READ CHANNEL!
/]
		 CALLI 12]
	MOVE	B,PPN			; PPN OF TABLE FILE
	MOVEM	B,ALFILE+3
	LOOKUP	CH,ALFILE		;LOOK UP TABLE FILE
	JRST	TRYMUL			;NOT FOUND, TRY MULTIPLE FILES
	SETOM	ALLOPN
	MOVSI	A,-8			; ONLY 8 WORDS TO READ IN
	MOVEI	B,SYTABS		; READ INTO XXUSET EVENTUALLY
	HRR	A,B
	SUBI	A,1
	SETZM	B
	IN	CH,A			; READ IN THE FIRST 8 WORDS IN THE FILE
	SKIPA				; SUCCESSFUL READ
	JRST	REDERR			; UNSUCCESSFUL READ
	MOVE	A,SYTABS+0		; GET FIRST USETNO INDEX
	MOVE	B,SYTABS+4		; GET FIRST USETNO
	MOVEM	B,USETNO(A)		; MOVE TO PROPER PLACE
	MOVE	A,SYTABS+1
	MOVE	B,SYTABS+5
	MOVEM	B,USETNO(A)
	MOVE	A,SYTABS+2
	MOVE	B,SYTABS+6
	MOVEM	B,USETNO(A)
	MOVE	A,SYTABS+3
	MOVE	B,SYTABS+7
	MOVEM	B,USETNO(A)
	JRST	FIRST			;NOW GO READ THE INDEX IN

TRYMUL:	SETOM	MULTFL			; BEGIN USING MULTIPLE FILES
	JRST	OPN
GETBP:	SKIPE	OVERLA			; SKIP IF NOT OVERLAYING
	JRST	GETOLD
	MOVEI	A,BPORG			;ACQUIRE BPS SPACE
	PUSHJ	P,EVAL
	PUSHJ	P,NUMVAL		;(A) IS FWA OF AVAILABLE BPS
	SKIPN	OLDBPO			; SKIP IF OLD BPORG ALREADY SAVED
	MOVEM	A,OLDBPO
	JRST	ADDIT

GETOLD:	SETZM	ISYN			;CLEAR ALL 4 OF ISYN,ISPAT,ICPAT,IDSKL
	MOVE	B,[XWD ISYN,ISYN+1]
	BLT	B,ISYN+3
	MOVE	A,OLDBPO
ADDIT:	PUSH	P,A			;SAVE THIS BPORG FOR LOAD
	MOVE	B,TBL
	ADD	A,PATMAX+1(B)		;(A) WILL BE NEW BPORG
	PUSH	P,A
	MOVEI	A,BPEND
	PUSHJ	P,EVAL
	PUSHJ	P,NUMVAL		;(A) IS BPEND
	POP 	P,B			;(B) WILL BE NEW REQUIREMENT
	CAMG	B,A			;SKIP IF WE'VE RUN OUT OF ROOM
	JRST	STORIT
	SKIPE	OVERLA			; SKIP IF NOT YET OVERLAYING
	JRST	OVRFLW
	SETOM	OVERLA			; START OVERLAYING
	POP	P,B			; POP UNUSABLE BPORG OFF STACK
	SETZM	ITSYN			;CLEAR ALL 4 OF ITSYN, ... ,ITDSKL
	MOVE	B,[XWD ITSYN,ITSYN+1]
	BLT	B,ITSYN+3
	JRST	GETOLD

OVRFLW:	OUTSTR	[ASCIZ/THE /]
	OUTSTR	@FILNAM
	OUTSTR	[ASCIZ/ TABLE WILL EXCEED THE BINARY PROGRAM SPACE LIMIT!
/]
	CALLI	12

STORIT:	MOVE	A,B			;THIS MAKES NEW BPORG INTO LISP NUMBER
	PUSHJ	P,FIX1A
	HRRZ	B,BPORG
	HRRZ	B,(B)
	HLRZ	B,(B)
	HRRM	A,(B)			;THIS STORES UPDATED BPORG
	POP	P,A			;(A) IS WHERE TABLES START PRIOR BPORG
	MOVE	ORG,A
	SUBI	A,1			;CONSTRUCT IOWD IN A FOR TABLE READ
	MOVE	C,TBL
	MOVN	B,PATMAX+1(C)
	HRL	A,B
	SETZM	B			;TERMINATE THE INPUT COMMAND LIST
	IN	CH,A			;READ TABLES
	SKIPA				; SUCCESSFUL READ
	JRST	REDERR			; UNSUCCESSFUL READ
	SKIPN	ALLOPN			; SKIP IF ALL.PAR IS OPEN
	RELEAS	CH,			; RELEASE INDIVIDUAL FILES
	MOVSI	A,-PATMAX		;RELOCATE THE TABLE ADDRESSES
	HRR	A,TBL
	ADDI	A,1
	SKIPE	@INDEX			; SKIP IF INDEX NOT RELOCATED
	JRST	RELVAL
	SETOM	@INDEX
STP2:	SKIPN	B,(A)			;TABLE FOR PATTERNS OF THIS LENGTH EXISTS
	JRST	STP3			;NO TABLE, CONTINUE
	ADD	B,ORG	 		;RELOCATE TABLE ADDRESS
	MOVEM	B,(A)			; RELOCATE TABLE NUMBER
	ADDM	ORG,(B)			;RELOCATE THE VALUE TABLE POINTER
STP3:	AOBJN	A,STP2			;CONTINUE
	JRST	RET			;RETURN

RELVAL:	SKIPE	B,(A)			;TABLE FOR PATTERNS OF THIS LENGTH EXISTS
	ADDM	ORG,(B)			;RELOCATE THE VALUE TABLE POINTER
	AOBJN	A,RELVAL		;CONTINUE
RET:	POP	P,A			;RESTORE ARG FOR CALLING PROGRAM
	POPJ	P,			;RETURN

REDERR:					; READ ERROR
	OUTSTR	[ASCIZ/CAN'T READ THE /]
	OUTSTR	@FILNAM
	OUTSTR	[ASCIZ/ FILE!
/]
	CALLI 12
MISC:
	; MISCELLANEOUS FAIL ROUTINES FOR PARRY

ROGER:
	MOVE	A,RCP			;THIS CHANGES TABLE FILE PPN TO ROGER'S
	MOVEM	A,PPN
	JRST	RETNIL			;RETURN NIL TO LISP

DATEUU: DATE	A,			; GET SYSTEM DATE
	PUSHJ	P,FIX1A
	POPJ	P,

TIMEUU:	TIMER	A,			; GET SYSTEM TIME
	PUSHJ	P,FIX1A
	POPJ	P,

RUNTIM:			; SETS RUNSAV IF NIL, RETURNS ELAPSED RUNTIME IF T
	MOVE	E,A
	SETZ 	A,
	RUNTIM 	A, 			; GET RUN TIME
	CAIE	E,NIL			; SKIP IF NIL, TO SET RUNSAV
	JRST	RN2			; GET ELAPSED TIME
	MOVEM	A,RUNSAV		; SAVE TIME
	POPJ	P,

RN2:	SUB	A,RUNSAV		; SUBTRACT OLD FROM NEW
	PUSHJ	P,FIX1A			; CONVERT
	POPJ	P,			; RETURN ELAPSED TIME
RUNSAV:	0

PPNUU:					; GET PPN IN SIXBIT
	GETPPN	A,
	PUSHJ	P,FIX1A
	POPJ	P,

TTYUU:					; GET TTY CHARACTERISTICS
	SETO	A,
	GETLIN	A
	PUSHJ	P,FIX1A
	POPJ	P,

PTYMUU:				; TRY TO GET NUMBER OF JOB CONTROLLING THIS PTYJOB
	MOVEI	A,270		; ADDRESS OF PTYJOB TABLE ADDRESS
	PEEK 	A,		; GET TABLE ADDRESS
	SETO 	B,
	GETLIN	B		; GET TTYLIN NO
	ANDI	B,177
	SUBI	B,121		; SUBTRACT TTYLINE NO OF FIRST PTYJOB
	ADD	A,B		; TABLE ADDRESS
	PEEK 	A,		; GET CONTROLLING JOB NO
	ANDI	A,77		; MASK -- NOW SHOULD HAVE CONTROLLING JOB NO IN A

	MOVEI	B,225		; ADDRESS OF JOBNAM TABLE ADDRESS
	PEEK	B,		; GET TABLE ADDRESS
	ADD	A,B		; ADD PTYJOB NO
	PEEK	A,		; GET JOBNAM
	PUSHJ	P,FIX1A		; CONVERT
	POPJ	P,

PTYOUU:
	PUSH	P,B		; SAVE INCR
	PUSHJ	P,NUMVAL	; CONVERT TABLE ADDR
	POP	P,B		; GET INCR
	PUSH	P,A		; SAVE TABLE ADDR
	MOVE	A,B
	PUSHJ	P,NUMVAL	; CONVERT INCR
	POP	P,B		; GET TABLE ADDR

	PEEK 	B,		; GET TABLE ADDRESS
	ADD	A,B		; TABLE ADDRESS
	PEEK 	A,		; GET CONTROLLING JOB NO
	PUSHJ	P,FIX1A		; CONVERT
	POPJ	P,
SWAPIT:
	MOVE 	A,[SAVADR,,0]
	SWAP 	A,
	POPJ	P,

FIX2Z:				; TO GIVE LISP ACCESS TO FIX1A
	PUSHJ	P,FIX1A
	POPJ	P,

SLEEP:				; (SLEEP N) WILL SLEEP FOR N SECONDS
	PUSHJ	P,NUMVAL	; CONVERT NUMBER INPUT TO FAIL NUMBER
	SLEEP	A,		; SLEEP FOR N SECONDS
	POPJ	P,		; RETURN

SNEAK:				; (SNEAK) WILL RETURN T IF SOMETHING IN TTY BUFFER
	SNEAKS	A,		; LOOK AT TTY BUFFER
	JRST	RETNIL		; NO CHAR WAITING
	MOVEI	A,T		; CHAR TYPED BUT NOT READ
	POPJ	P,

INCHAR:				; (INCHAR) WILL READ A CHAR FROM THE INPUT BUFFER
				;   AND RETURN IT AS AN ATOM, OR ELSE NIL IF
				;   THERE WAS NOTHING TYPED IN
	INCHRS	CHAR		; READ IN ONE CHAR IN CHAR-MODE (NOT LINE-MODE)
	JRST	RETNIL		; NO CHAR TYPED, RETURN NIL
	MOVE	B,CHAR		; GET CHAR
	LSH	B,=29		; PUT IN TOP 7 BITS
	MOVE	A,[B]		; LOCATION OF THE CHARS
	PUSHJ	P,MAKATM	; MAKE IT A LISP ATOM
	POPJ	P,		; RETURN ATOM NAME READ IN


SWAPNO:				; SWAPNO SWAPS IN A PROGRAM CALLED NO[DIA,KMC]
	MOVE 	A,[0,,GETADR]
	SWAP 	A,
	POPJ	P,

SWAPP:				; SWAPP SWAPS IN A PROGRAM CALLED P[DIA,KMC]
	MOVE 	A,[0,,GETADP]
	SWAP 	A,
	POPJ	P,

NAMEIN:				; NAMEIN GETS THE NUMBER OF PARRYS RUNNING
	SETO	C,
	GETNAM	C,		; GET CURRENT JOB NAME AND SAVE
	MOVE	B,[SIXBIT /CHECK /]	; SET JOB NAME TO CHECK
	SETNAM	B,
	MOVE	A,[SIXBIT /PARRY /]
	NAMEIN	A,		; SKIPS IF 0,2,OR MANY JOBS
	JRST	NAMEI2		; CODE OF 1 OR 3 IN A, FOR 0 OR MANY JOBS
	MOVEI	A,2		; IN A, IS # JOBS + 1
NAMEI2: SUBI	A,1
	PUSHJ	P,FIX1A		; MAKE THE NUMBER OF JOBS A LISP NUMBER
	SETNAM	C,		; RESET JOB NAME
	POPJ	P,
NEDIT:		; TAKES A 4 DIGIT NUMBER (0 < X ≤ 9999) AND FORMATS WITH A DECIMAL
		; POINT AND PUTS INTO A LISP STRING

	PUSHJ	P,NUMVAL	; CONVERT TO A FAIL NUMBER
	IDIVI	A,=10		; QUO IN A, REMAINDER (LOW ORDER DIGIT) IN B
	ADDI	B,060		; CONVERT TO ASCII
	MOVE	E,B
	LSH	E,7
	ORI	E,042		; PUT " MARK IN
	LSH	E,=22		; SHIFT ALL THE WAY TO THE LEFT
	PUSH	P,E		; SAVE ON STACK
	IDIVI	A,=10		; GET NEXT DIGIT
	ADDI	B,060
	MOVEI	E,056		; PUT PERIOD IN
	LSH	E,7		; ROOM FOR DIGIT
	OR	E,B		; PUT IN DIGIT
	IDIVI	A,=10		; NEXT DIGIT
	ADDI	B,060		; MAKE ASCII
	LSH	B,=14		; POSITION
	OR	E,B		; MOVE TO E
	IDIVI	A,=10		; GET LAST DIGIT
	ADDI	B,060		; MAKE ASCII
	CAIN	B,060		; COMPARE TO THE CHAR ZERO, SKIP IF NOT EQUAL
	MOVEI	B,040		; MAKE A SPACE INSTEAD OF A LEADING ZERO
	LSH	B,=21		; POSITION
	OR	E,B
	MOVEI	B,042		; FIRST " MARK
	LSH	B,=28		; POSITION
	OR	E,B		; INTO E
	LSH	E,1		; SHIFT ALL THE WAY TO THE LEFT
	PUSH	P,E		; STORE ON STACK, FIRST WORD ON TOP, SECOND ON BOTTOM

	PUSHJ	P,GETFW		; GET A FULL WORD FROM LISP
	PUSH	P,A		; SAVE THE PTR TO THIS FULL WD
	PUSHJ	P,GETFW		; GET ANOTHER FULL WORD FROM LISP
	EXCH	B,-2(P)		; SECOND WORD OF ASCII
	MOVEM	B,(A)		; PUT INTO A FULL WORD
	PUSHJ	P,NCONS		; CONS NIL ONTO SECOND WORD
	POP 	P,B		; GET PTR TO OTHER FULL WD
	POP	P,C		; GET FIRST WORD OF ASCII
	MOVEM	C,(B)		; MOVE ASCII INTO A FULL WORD
	POP	P,D		; CLEAN THE STACK
	PUSHJ	P,XCONS		; CONS THE TWO TOGETHER
	PUSHJ	P,NCONS		; CONS WITH NIL
	MOVEI	B,PNAME
	PUSHJ	P,XCONS		; CONS ON PROPERTY NAME
	MOVEI	B,ATMHDR	; MAKE THE ATOM HEADER
	PUSHJ	P,XCONS		; (A) IS THE STRING
	POPJ	P,		; DONE


GETFW:			; GET A FULL WORD FROM LISP AND LEAVE ITS PTR IN A
	SKIPN	FW	; SKIP IF THERE IS ONE
	PUSHJ	P,GC	; ELSE GARBAGE COLLECT
	MOVE	A,FW	; (A) IS A FULL WORD ADDRESS
	HRRZ	FW,(FW)	; UNLINK
	POPJ	P,	; RETURN

OCTOUT:				;PRINTS WORD IN REGISTER "C" IN OCTAL
	MOVN	E,TWELV
OCLOOP:	ROT	C,3
	HRR	D,C
	ANDI	D,7
	ORI	D,60
	OUTCHR	D
	AOJL	E,OCLOOP
	OUTSTR	[ASCIZ /
/]
	POPJ	P,
TWELV:	14

END